PD ROM 1/PD ROM Volume I - Macintosh Software from BMUG (1988).iso/Programming/Programming Tools/Turbo Pascal/Utilities/FILEUT.PAS

Pascal/Delphi Source File | 1987-06-16 | 14.0 KB | 455 lines | [TEXT/ttxt]

UNIT FileUT(56); {              Version 2.1a                     87/03/16

  Some file-related routines to make life easier for the MacTURBO programmer.

  Features:

     1) Use the standard file dialogs to open & close TURBO files.

     2) Launch applications from your TURBO program.

     3) Some procedures to make translation from TURBO 3.0 a little easier.


  History:

    86/12/31 - Origional version of this file.

    87/03/14 - Version 2.0. Added SFDialogs stuff. (Mike Babulic, CIS:72037,314)

    87/03/15 - Version 2.1. To change the File Type & Creator use the
               standard MacTURBO Pascal variables:
                  FileType, FileCreator,
                  TextType, TextCreator : packed array[1..4] of char;
}

INTERFACE

{$U-}

  USES MemTypes,QuickDraw,OSIntf,ToolIntf,PackIntf,PasInOut;

{------------------------------------------------------------------------------}

const
  DefaultBlockSize = 512;      { Standard block size on Macintosh }

type
  FileBuf = packed array[0..MaxInt] of char;
  FileBufferPtr = ^FileBuf;
  FileProcPtr = ^Integer;
  FileRec = record    { Internal format of a Turbo file variable }
              FInpFlag : boolean;
              FOutFlag : boolean;
              FRefNum  : integer;  { Reference number is used for }
              FVRefNum : integer;       { Mac File Manager calls }
              FBufSize : integer;
              FBufPos  : integer;
              FBufEnd  : integer;
              FBuffer  : FileBufferPtr;
              FInOutProc : FileProcPtr;
            end;
  FileRecPtr = ^FileRec;

{----------------------------------------------------------------------------}



const
  TextFile = -1;        {If the "SizeOf" parameter in the routines below is
                           equal to this value. The file will be opened as a
                           TEXT file}

type

  UntypedFile = file of byte;  { Block operations are on untyped, }

var
  FileBlockSize : LongInt;        {Bytes in a given block }
  FileErr : OSErr;                {see File Manager in Inside Mac}

  SFDialog : record               {Stuff used by Standard File Dialog}
    where : Point;                   {Where to place the SFDialogs}
    prompt: str255;                  {Used by the SFDialogs}
    InpFileTypes : string[16];       {SFGetFile Search Types}
    r : SFReply;                     {Results from StFDialog goes Here}
    end;




FUNCTION SFGetReset(var f; SizeOf:LongInt; fName: str255):Boolean;
  {Use the SFGetFile dialog to Open & Reset the file "f"
     If "SizeOf" is "TextFile" then "f" is "Reset(Text(f))"
     otherwise "SizeOf" contains the length of a file record and
     f is "Reset(UntypedFile(f))"                   }

FUNCTION SFGetRewrite(var f; SizeOf:LongInt; fName: str255):Boolean;
  {Use the SFGetFile dialog to Open & Rewrite the file "f".
     If "SizeOf" is "TextFile" then "f" is "Rewrite(Text(f))"
     otherwise "SizeOf" contains the length of a file record and
     f is "Rewrite(UntypedFile(f))"                 }

FUNCTION SFGetCreate(var f; SizeOf:LongInt; fName: str255):Boolean;
  {Use the SFGetFile dialog to Create a NEW file "f".
     If "SizeOf" is "TextFile" then "f" is "Rewrite(Text(f))"
     otherwise "SizeOf" contains the length of a file record and
     f is "Rewrite(UntypedFile(f))"                 }

FUNCTION SFGetAppend(var f:Text; fName: str255):Boolean;
  {Use the SFGetFile dialog to open "f" and go to the END OF the FILE
   so as to APPEND any "writes" to the end of the file "f"}

FUNCTION SFGetDelete(theFile: str255):Boolean;
  {Use the SFGetFile dialog to Delete the file "f"  }

FUNCTION SFGetLaunch:boolean;
  {Use the SFGetFile dialog to LAUNCH another application}



FUNCTION SFPutRewrite(var f; SizeOf:LongInt; fName: str255):Boolean;
    {Use the SFPutFile dialog to Open & Rewrite the file "f"
         If "SizeOf" is "TextFile" then "f" is "Rewrite(Text(f))"
         otherwise "SizeOf" contains the length of a file record and
         f is "Rewrite(UntypedFile(f))"  }


FUNCTION SFPutCreate(var f; SizeOf:LongInt; fName: str255):Boolean;
    {Use the SFPutFile dialog to Create a NEW file "f".
         If "SizeOf" is "TextFile" then "f" is "Rewrite(Text(f))"
         otherwise "SizeOf" contains the length of a file record and
         f is "Rewrite(UntypedFile(f))"  }




FUNCTION GetFile(var f; var theFile:str255):Boolean;
  {Use the SFGetFile dialog -- nb. f.fVrefNum contains the volume #}

FUNCTION PutFile(var f; var theFile:str255):Boolean;
  {Use the SFPutFile dialog -- nb. f.fVrefNum contains the volume #}




PROCEDURE Str2Types(TypeList:str255; MaxCount:integer;
                    VAR count:integer; VAR tl:SFTypeList);
    {Translate the string into an SFTypelist}




PROCEDURE Append(var f:Text; fName: str255);
    { For Turbo 3.0 Compatability: Append Text file output to the end of the
      named file}

PROCEDURE Execute(progName: str255);
    { For Turbo 3.0 Compatability: Execute the named program}

PROCEDURE BlockRead(var f:UntypedFile;
                    var Buf;
                        NumBlocks: LongInt;
                    var BlocksRead: LongInt);
    { For Turbo 3.0 Compatability: Reads NumBlocks of Data from f into Buf.
            BlocksRead is the number of blocks actually read.}

PROCEDURE BlockWrite(var f:UntypedFile;
                     var Buf;
                         NumBlocks: LongInt;
                     var BlocksWritten: LongInt);
    { For Turbo 3.0 Compatability: Reads NumBlocks of Data from f into Buf.
            BlocksWritten is the number of blocks actually read.}




IMPLEMENTATION

 procedure Str2Types{TypeList:str255; MaxCount:integer;
                      VAR count:integer; VAR tl:SFTypeList);        };
  VAR i,j,k: INTEGER;
  begin
    count :=Length(TypeList) DIV 4;
    if count>MaxCount then count := MaxCount;
    k := 0;
    for i := 0 to count-1 do begin
      for j := 1 to 4 do begin
        tl[i][j] := TypeList[j+k];
      end;
      k := k + 4;
    end;
  end;

(***************************************************************************)

FUNCTION GetFile{var f; var theFile:str255):boolean;        };
 var where : point;
      count: Integer;
      tl   : SFTypeList;
  begin with FileRec(f) do with SFDialog do begin
    FileErr := noErr;
    Str2Types(SFDialog.InpFileTypes,4,count,tl);
    SFGetFile(SFDialog.where,theFile,NIL,count,tl,NIL,r);
    GetFile := r.good;
    IF r.good THEN with r do begin
      FileErr := SetVol(NIL,vRefNum);
      FvRefNum := vRefNum;
      theFile  := fName;
    END;
  end end;

FUNCTION PutFile{var f; var theFile:str255):boolean;        };
 var where : point;
      count: Integer;
      r    : SFReply;
  begin with FileRec(f) do with SFDialog do begin
    FileErr := noErr;
    SFPutFile(SFDialog.where,SFDialog.prompt,theFile,NIL,r);
    PutFile := r.good;
    IF r.good THEN with r do begin
      FileErr := SetVol(NIL,vRefNum);
      FvRefNum := vRefNum;
      theFile  := fName;
    END;
  end end;
{$I-}
FUNCTION ResetFile(var f; SizeOf:LongInt):Boolean;
  begin with FileRec(f) do with SFDialog do with r do begin
    if SizeOf = TextFile then
      reset(Text(f),fName,FileBlockSize)
    else begin
      reset(UntypedFile(f),fName);
      FBufSize := SizeOf;
    end;
    FileErr := IOResult;
    ResetFile := (FileErr = noErr);
  end end;

FUNCTION RewriteFile(var f; SizeOf:LongInt; Nuke:boolean):Boolean;
  PROCEDURE RewriteType;
    begin
      if SizeOf = TextFile then
        rewrite(Text(f),SFDialog.r.fName,FileBlockSize)
      else begin
        rewrite(UntypedFile(f),SFDialog.r.fName);
        with FileRec(f) do
          FBufSize := SizeOf;
      end;
      FileErr := IOResult;
    end;
  begin
    if Nuke then begin
      FileErr := FSDelete(SFDialog.r.fName,0);
      if (FileErr=NoErr) or (FileErr=FNFErr) then
        RewriteType
      end
    else begin
      RewriteType;
    end;
    RewriteFile := FileErr = noErr;
  end;
{$I+}
(**************************************************************************)

FUNCTION SFGetReset{var f; SizeOf:LongInt; fName:str255):Boolean;         };
  var   ok: boolean;
  begin
    SFGetReset := FALSE;
    if GetFile(f,fName) then
      SFGetReset := ResetFile(f,SizeOf);
  end;

FUNCTION SFGetRewrite{var f; SizeOf:LongInt; fName:str255):Boolean;        };
  begin
    SFGetRewrite := FALSE;
    if GetFile(f,fName) then
      SFGetRewrite := RewriteFile(f,SizeOf,FALSE);
  end;

FUNCTION SFGetCreate{var f; SizeOf:LongInt; fName:str255):Boolean;        };
  begin
    SFGetCreate := FALSE;
    if GetFile(f,fName) then
      SFGetCreate := RewriteFile(f,SizeOf,TRUE);
  end;

FUNCTION SFGetDelete{theFile:str255):Boolean;            };
  type strPtr = ^str255;
  var f: FileRec;
  begin with SFDialog do with r do begin
    SFGetDelete := FALSE;
    if GetFile(f,theFile) then begin
      FileErr := FSDelete(fName,f.FvRefNum);
      SFGetDelete := (FileErr = NoErr);
    end;
  end end;

PROCEDURE Append{f:Text; fName: str255);                 };
  {Open Text file so that "writes" will append to its end}
  begin
    reset(f,fName);
    with FileRec(f) do begin
      FInpFlag := FALSE;
      FOutFlag := TRUE;
      FileErr  := SetFPos(FRefNum,FsFromLEOF,1);
    end;
  end;

FUNCTION SFGetAppend{var f:Text; fName: str255):Boolean;            };
  var ok : boolean;
  begin
    ok := SFGetReset(f,TextFile,fName);
    SFGetAppend := ok;
    if ok then
      with FileRec(f) do begin
        FInpFlag := FALSE;
        FOutFlag := TRUE;
        FileErr  := SetFPos(FRefNum,FsFromLEOF,1);
        SFGetAppend := (FileErr=EOFErr);
      end;
  end;

FUNCTION SFPutRewrite{var f; SizeOf:LongInt; fName:str255):Boolean;        };
  begin
    SFPutRewrite := FALSE;
    if PutFile(f,fName) then
      SFPutRewrite := RewriteFile(f,SizeOf,FALSE);
  end;

FUNCTION SFPutCreate{var f; SizeOf:LongInt; fName:str255):Boolean;        };
  begin
    SFPutCreate := FALSE;
    if PutFile(f,fName) then
      SFPutCreate := RewriteFile(f,SizeOf,TRUE);
  end;

(****************************************************************************)

TYPE LaunchRec = record             {Used by the Inline routine below }
       ProgramName  : ^Str255;      {  see "Inside Macintosh II" pp.59-60}
       SoundBuffer  : integer;
       end;

PROCEDURE LaunchIt(var L:LaunchRec);
 inline
    $205F,      { MOVE.L    (SP)+,A0    } { move parameter to A0 }
    $A9F2;      { _LAUNCH               }

PROCEDURE Execute{progName: str255);                     };
  {Launch the program progName}
  var L: LaunchRec;
      F: file of Byte;
  begin
    Reset(F,ProgName); {The program will crash here if the file doesn't exist}
    Close(F);
    with L do begin
      SoundBuffer := 0;
      { uses Main sound & screen buffers. If you want the current buffer,
        you need to write inline to get it from the variable CurPageOption.}
      ProgramName := @progName;
    end;
    LaunchIt(L);
  end;

FUNCTION SFGetLaunch{:boolean;                          };
  {Launch a program using the SFGetFile Dialog}
  var L: LaunchRec;
      types: SFTypeList;
      ok: boolean;
  begin with SFDialog do with r do begin
    types[0] := 'APPL';
    SFGetFile(where,'',NIL,1,types,NIL,r);
    IF Good THEN begin
      Good := (FileErr = NoErr);
      FileErr := SetVol(NIL,vRefNum);
      if Good then begin
        with L do begin
          SoundBuffer := 0;
          { uses Main sound & screen buffers. If you want the current buffer,
            you need to write inline to get it from the variable CurPageOption.}
          ProgramName := @r.fName;
        end;
        LaunchIt(L);
      end;
    end;
    SFGetLaunch := Good;
  end end;

{
  procedure WriteFileRec(var f:UntypedFile);
    begin with FileRec(f) do begin
      writeln('FinpFlag = ',FinpFlag);
      writeln('FOutFlag = ',FOutFlag);
      writeln('FBufSize = ',FBufSize);
      writeln('FBufPos  = ',FBufPos);
      writeln('FBufEnd  = ',FBufEnd);
      writeln('FBuffer  = ',LongInt(FBuffer));
      writeln('FInOutProc = ',LongInt(FInOutProc));
    end end;
 }

(*****************************************************************************)

PROCEDURE BlockRead{var f:UntypedFile;
                    var Buf;
                        NumBlocks: LongInt;
                    var BlocksRead: LongInt);
      For Turbo 3.0 Compatability: Reads NumBlocks of Data from f into Buf.
            BlocksRead is the number of blocks actually read.};
  begin with FileRec(f) do begin
    BlocksRead := NumBlocks * FBufSize;                     {Convert to # of Bytes}
    if BlocksRead > 0 then begin
      FileErr := FSRead(FRefNum, BlocksRead, @Buf);
      BlocksRead := (BlocksRead+fBufSize-1) DIV FBufSize;   {Convert to # of Blocks}
    end;
  end end;

PROCEDURE BlockWrite{var f:UntypedFile;
                    var Buf;
                        NumBlocks: LongInt;
                    var BlocksRead: LongInt);
      For Turbo 3.0 Compatability: Reads NumBlocks of Data from f into Buf.
            BlocksRead is the number of blocks actually read.};
  begin with FileRec(f) do begin
    BlocksWritten := NumBlocks * FBufSize;                      {Convert to # of Bytes}
    if BlocksWritten > 0 then begin
      FileErr := FSWrite(FRefNum, BlocksWritten, @Buf);
      BlocksWritten := (BlocksWritten+fBufSize-1) DIV FBufSize; {Convert to # of Blocks}
    end;
  end end;

(*****************************************************************************)

begin
  FileBlockSize := DefaultBlockSize;
  FileErr := noErr;
  with SFDialog do begin
    SetPt(where,100,100);
    prompt := 'Save file as:';
    InpFileTypes := 'TEXT';
  end;
end.

(****************** Example Program:**************************
program test;

  {$U FileUT}
  USES MemTypes,QuickDraw,OSIntf,ToolIntf,PackIntf,FileUT;

var f : text;
    s : str255;

begin
  if SFGetReset(f,TextFile,'') then begin
    while not eof(f) do begin
      readln(f,s);
      writeln(s);
    end;
    Close(f);
    end
  else
    writeln('FileError =',FileErr);
  repeat until keypressed;
end.
*)